VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsInsertCancel"
Attribute VB_GlobalNameSpace = True
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private lngTotalRecordSum As Long
Private lngTotalRecords As Long

Private dblGrossRemSum As Double
Private dblGrossRemPayeSum As Double
Private dblTaxFreeSum As Double
Private dblAssessedTaxAmountSum As Double
Private dblProvisionalTaxAmountSum As Double
Private dblVatAmountSum As Double
Private dblPayeAmountSum As Double
Private dblTaxRateSum As Double
Private Sub ResetTotals()

    lngTotalRecords = 0
    dblGrossRemSum = 0
    dblGrossRemPayeSum = 0
    dblTaxFreeSum = 0
    dblAssessedTaxAmountSum = 0
    dblProvisionalTaxAmountSum = 0
    dblVatAmountSum = 0
    dblPayeAmountSum = 0
    dblTaxRateSum = 0

End Sub


Public Function Insert() As Long
'   This function is the main calling function for the insert from rasrs response file to the database
                
    Dim strHeader As String
    Dim strFooter As String
    Dim colLineString As Collection
    Dim colRecords As Collection
    Dim lngNoDataReason As Long
    Dim strFileNamePath As String
        
    On Error GoTo Insert_Fix
    
    Insert = 0
        
     If objAdoConn.InitConnect(, "Keytax SQL", "KeyTax") Then
        Do While objFileFunctions.FileDataToInsert(strFileNamePath, lngNoDataReason)
        'if you want to exit the dir search on errors
'            If lngErrorCount > 0 Then
'              Exit Do
'            End If
            ResetTotals
            Set colLineString = New Collection
            Set colRecords = New Collection
            lngTotalRecords = 0
            HeaderFileFlag = False
            If objFileFunctions.ReadFile(strFileNamePath, strHeader, strFooter, colLineString) Then
                If TokenizeRecordString(colLineString, colRecords) Then
                    If ValidateFooter(strFooter) Then
                        If PerformUpdate(colRecords) Then
                            If objFileFunctions.FileCleanUp(strFileNamePath) Then
                                lngTotalRecordSum = lngTotalRecordSum + lngTotalRecords
                                Insert = lngTotalRecordSum
                            Else
                                Insert = FILE_CLEAN_UP_ERROR
                            End If
                        Else
                            Insert = ERROR_INSERTING_RECORD
                        End If
                    Else
                        Insert = ERROR_IN_FOOTER_AGGREGATES
                    End If
                Else
                    Insert = ERROR_FORMATING_RECORDS
                End If
            Else
              If Not HeaderFileFlag Then
                Insert = ERROR_READING_RECORDS
              End If
            End If
        Loop
        Insert = lngNoDataReason
    Else
        Insert = DATABASE_CONNECTION_FAILED
    End If

    Exit Function
Insert_Fix:
    HandleError Err.Number, Err.Description, "Insert"
    Insert = UNKNOWN_ERROR_OCCURRED
End Function





Private Function TokenizeRecordString(colFixedString As Collection, colTokenizedRecs As Collection) As Boolean
'   This function extracts the data from the database, calculates the totals
'   formats each record and saves it to a dynamic array

  
    Dim strTemp As Variant
    Dim strSql As String
    Dim i As Long
    Dim j As Integer
    Dim varRecords(44)
    Dim strFillString As String
    Dim dblProvTaxAmt As Double 'needs to be summed *3 here for aggregates
    
    On Error GoTo TokenizeRecordString_Fix
    
    frmShanksOpt.Show
    frmShanksOpt.intCancel = 0
    
    Set colTokenizedRecs = New Collection
    
    For i = 1 To colFixedString.Count
    
        strTemp = colFixedString(i)
                
        If Len(strTemp) = 50 Then
            'strTemp = colFixedString(i) & String(223, "0")
            strTemp = colFixedString(i) & Space(253)
        End If
        
        'remove record id
        strTemp = Right(strTemp, Len(strTemp) - 1)
        
        varRecords(0) = NumericFormat(Mid(strTemp, 1, 20))
        'REQ-SEQ_NUM, LEN:20, , NUMERIC ACCORDING TO DB
        strTemp = Right(strTemp, Len(strTemp) - 20)
        
         varRecords(1) = NumericFormat(Mid(strTemp, 1, 15))
        'DIR_ID, LEN:15, BLANKS IF NULL,, NUMERIC ACCORDING TO DB
        strTemp = Right(strTemp, Len(strTemp) - 15)
        
        varRecords(2) = NumericFormat(Mid(strTemp, 1, 10))
        'IT_REF_NO, LEN:10, NUMERIC, BLANKS IF NULL
        strTemp = Right(strTemp, Len(strTemp) - 10)
        
        varRecords(3) = AlphaFormat(Mid(strTemp, 1, 2))
        'DIR_STATUS, LEN:2, ALPHA, ZERO OR BLANK
        strTemp = Right(strTemp, Len(strTemp) - 2)
        
        varRecords(4) = AlphaFormat(Mid(strTemp, 1, 2))
        'RESPONSE, LEN:2, ALPHA, ZERO OR BLANK
        strTemp = Right(strTemp, Len(strTemp) - 2)
        
        varRecords(5) = AlphaFormat(Mid(strTemp, 1, 253))
        'RESPONSE-TEXT, LEN:253, ALPHA, ZERO OR BLANK
        strTemp = Right(strTemp, Len(strTemp) - 253)
        
        lngTotalRecords = lngTotalRecords + 1
        
        If Len(strTemp) <> 0 Then
            MsgBox "Error"
            TokenizeRecordString = False
        Else
            TokenizeRecordString = True
        End If
                
        colTokenizedRecs.Add varRecords, CStr(i)
        
        DoEvents
        frmShanksOpt.pgbPercent.Value = (i / colFixedString.Count) * 100
        frmShanksOpt.Label1.Caption = "Extracting from Sars Response File. Record:  " & i & " of : " & colFixedString.Count
        frmShanksOpt.Refresh
        
    Next i
   
   Exit Function
TokenizeRecordString_Fix:
   HandleError Err.Number, Err.Description, "TokenizeRecordString", "Error occurred while tokenizing string/calculating aggregates.", i
   TokenizeRecordString = False
End Function

Private Function ValidateFooter(strFooter As String) As Boolean

    Dim arFooter(9) As Variant
    Dim strTemp As String
        
    On Error GoTo ValidateFooter_Fix
        
    strTemp = strFooter
    
    'remove record id
    strTemp = Right(strTemp, Len(strTemp) - 1)
    
    arFooter(0) = NumericFormat(Mid(strTemp, 1, 8))
    arFooter(0) = IIf(arFooter(0) = "NULL", 0, arFooter(0))
    'REC-NO, LEN:8, JUXT:RIGHT, PADDED:BLANK, NUMERIC, (total no of records in file)
    strTemp = Right(strTemp, Len(strTemp) - 8)

    If Trim(CDbl(arFooter(0))) = lngTotalRecords Then
        ValidateFooter = True
    Else
        HandleError Err.Number, Err.Description, "Calculate Aggregates error."
        ValidateFooter = False
    End If
                
    Exit Function
ValidateFooter_Fix:
    HandleError Err.Number, Err.Description, "ValidateFooter"
    ValidateFooter = False
End Function


Private Function AlphaFormat(Preformat As Variant) As String

    Dim strTemp As String
    
    If Preformat = 0 Then
        AlphaFormat = "NULL"
    Else
        strTemp = "'" & Trim(Preformat) & "'"
        AlphaFormat = strTemp
    End If
End Function
Private Function DateFormat(Preformat As Variant) As String

    Dim strTemp As String
    Dim dtDate As Date
    Dim strSqlDateFormat As String
    Dim strNewFormat As String
    Dim strYYYY As String
    Dim strMM As String
    Dim strDD As String
    
    If Preformat = 0 Then
        DateFormat = "NULL"
    Else
        strTemp = Trim(Preformat)
        If Len(strTemp) > 4 Then
            'Migrating Conversion Functions from Oracle to SQL Server:
            'Character strings are converted to dates. In Oracle, the default date format model is DD-MON-YY.
            'If you use any other format, you must provide an appropriate date format model.
            'The CAST and CONVERT functions convert standard date formats automatically, without the need for
            'a format model.
            
            'all dates will be 8 long CCYYMMDD eg 21081975 - as per sars documentation
            
            strYYYY = Left(strTemp, 4)
            strMM = Mid(strTemp, 5, 2)
            strDD = Right(strTemp, 2)
            strNewFormat = strDD & "/" & strMM & "/" & strYYYY
            strTemp = "'" & Format(strNewFormat, "DD-MMM-YYYY") & "'"
            strSqlDateFormat = " (CONVERT(datetime," & strTemp & ", 5)) "
            DateFormat = strSqlDateFormat '"insert into bm_test (tdate) values" & strSqlDateFormat
        Else
            strTemp = "'" & strTemp & "'"
        End If
    End If
End Function
Private Function NumericFormat(Preformat As Variant, Optional strType As String) As String

    
    Dim lngCents As Double
    Dim lngRands As Double
    Dim lngValue As Double
    
    If Len(Trim(Preformat)) = 0 Then
        Preformat = 0
    End If
    
    
    If Preformat = 0 Then
        NumericFormat = "NULL"
    ElseIf UCase(strType) = "CENTS" Then
        NumericFormat = Preformat / 100
    Else
        lngValue = Preformat 'to get rid of padding
        NumericFormat = lngValue
    End If

End Function

Public Function PerformUpdate(colFileData As Collection) As Boolean

    Dim lngRecordsAffected As Long
    Dim strSql As String
    Dim rsExistingReference As ADODB.Recordset
    Dim i As Long
    Dim j As Integer

  Dim arFileData As Variant

    On Error GoTo PerformUpdate_Fix

    For i = 1 To colFileData.Count
    strSql = "Select REQ_SEQ_NUM from DIR_REQUEST_FORMS where REQ_SEQ_NUM = " & colFileData(i)(0)
        Set rsExistingReference = objAdoConn.OpenRecordset(strSql)
        If rsExistingReference.RecordCount > 0 Then
            If Not IsNull(rsExistingReference(0)) Then
                strSql = "Update DIR_REQUEST"
                strSql = strSql & " set SCOD_PROCESS_STATUS = 'RS' ,"
                strSql = strSql & " PROCESS_STATUS_DATE = GETDATE() ,"
                strSql = strSql & " RES_FILE_NAME = '" & objReg.AsciiFileName & "'"
                strSql = strSql & " where REQ_SEQ_NUM = " & colFileData(i)(0)
                            
                lngRecordsAffected = objAdoConn.ExecuteQuery(strSql)
                If lngRecordsAffected <> 1 Then
                    HandleError 0, "Update Dir_Request(SCOD_PROCESS_STATUS) failed.", "GetRecords", "Insert failed on REQ_SEQ_NUM: " & colFileData(i)(0) & "."
                    PerformUpdate = False
                Else
                    strSql = "Update DIR_RESPONSE"
                    strSql = strSql & " set CANCEL_PROCESS_STATUS = 'RS' ,"
                    strSql = strSql & " CANCEL_STATUS = " & colFileData(i)(4) & " ,"
                    strSql = strSql & " REQUEST_STATUS = " & colFileData(i)(3) & " ,"
                    strSql = strSql & " EMAILED_YN = 'N'"
                    strSql = strSql & " where REQ_SEQ_NUM = " & colFileData(i)(0)
                    lngRecordsAffected = objAdoConn.ExecuteQuery(strSql)
                    If lngRecordsAffected <> 1 Then
                        HandleError 0, "Update Dir_Request(SCOD_PROCESS_STATUS) failed.", "GetRecords", "Insert failed on REQ_SEQ_NUM: " & colFileData(i)(0) & "."
                        PerformUpdate = False
                    Else
                        PerformUpdate = True
                    End If
                End If
            Else
                HandleError 0, "No matching request for this response.", "PerformUpdate", "Req_seq_num: " & colFileData(i)(0), i
                PerformUpdate = False
            End If
        Else
            HandleError 0, "No matching request for this response.", "PerformUpdate", "Req_seq_num: " & colFileData(i)(0), i
            PerformUpdate = False
        End If



        DoEvents
        frmShanksOpt.pgbPercent.Value = (i / colFileData.Count) * 100
        frmShanksOpt.Label1.Caption = "Inserting Response detail into database. Record:  " & i & " of : " & colFileData.Count
        frmShanksOpt.Refresh
        Unload frmShanksOpt
    Next i

    Exit Function
PerformUpdate_Fix:
    HandleError Err.Number, Err.Description, "PerformUpdate", "Failed to insert record.", i
    PerformUpdate = False
End Function


Private Sub Class_Initialize()
  If objReg Is Nothing Then
    Set objReg = New clsRegistry
  End If
  If objAdoConn Is Nothing Then
    Set objAdoConn = CreateObject("AdoDbserver.clsDbFunctions")
  End If
  If objFileFunctions Is Nothing Then
    Set objFileFunctions = New clsFileFunctions
  End If
End Sub
Private Sub Class_Terminate()
  Set objReg = Nothing
  Set objAdoConn = Nothing
  Set objFileFunctions = Nothing
End Sub
Public Function GetErrorMessage(ErrorNumber As Long) As String


    If ErrorNumber > 0 Then
        GetErrorMessage = ErrorNumber & " records were extracted from file " & objReg.AsciiFileLocation & "\" & objReg.AsciiFileName & " and inserted into the database."
    Else
        Select Case ErrorNumber
            Case 0
                GetErrorMessage = "NO_DATA_TO_INSERT "
            Case -1
                GetErrorMessage = "DATABASE_CONNECTION_FAILED "
            Case -2
                GetErrorMessage = "FILE_ERROR "
            Case -3
                GetErrorMessage = "ERR_IN_FILE_SEQ_NO "
            Case -4
                GetErrorMessage = "ERROR_CREATING_HEADER_RECORD "
            Case -5
                GetErrorMessage = "ERROR_CREATING_FOOTER_RECORD "
            Case -6
                GetErrorMessage = "ERROR_READING_RECORDS "
            Case -7
              GetErrorMessage = "ERROR_FORMATING_RECORDS"
            Case -8
              GetErrorMessage = "ERROR_INSERTING_RECORD"
            Case -9
              GetErrorMessage = "FILE_CLEAN_UP_ERROR"
            Case -10
              GetErrorMessage = "UNKNOWN_ERROR_OCCURRED"
            Case -11
              GetErrorMessage = "RESPONSE_FILE_LOCATION_UNKNOWN"
        End Select
    End If

End Function
